home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / examples / graphcalc2.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1991-10-05  |  5.5 KB  |  154 lines
  1. ; -*-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;
  4. ; File:         graphcalc-sliderdisp.lsp
  5. ; RCS:          $Header: graphcalc2.lsp,v 1.2 91/10/05 16:03:37 mayer Exp $
  6. ; Description:  Add a scale widget to display results from graphcalc.lsp
  7. ; Author:       Niels Mayer, HPLabs
  8. ; Created:      Tue Jul 10 10:35:58 1990
  9. ; Modified:     Sat Oct  5 16:03:14 1991 (Niels Mayer) mayer@hplnpm
  10. ; Language:     Lisp
  11. ; Package:      N/A
  12. ; Status:       X11r5 contrib tape release
  13. ;
  14. ; WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  15. ; XLISP version 2.1, Copyright (c) 1989, by David Betz.
  16. ;
  17. ; Permission to use, copy, modify, distribute, and sell this software and its
  18. ; documentation for any purpose is hereby granted without fee, provided that
  19. ; the above copyright notice appear in all copies and that both that
  20. ; copyright notice and this permission notice appear in supporting
  21. ; documentation, and that the name of Hewlett-Packard and Niels Mayer not be
  22. ; used in advertising or publicity pertaining to distribution of the software
  23. ; without specific, written prior permission.  Hewlett-Packard and Niels Mayer
  24. ; makes no representations about the suitability of this software for any
  25. ; purpose.  It is provided "as is" without express or implied warranty.
  26. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  27.  
  28. ; (send (get_moused_widget) :destroy)
  29. ; (send calc_keyboard_w :set_values :xmn_editable t)
  30.  
  31. (setq  disp_slider_w
  32.  (send XM_SCALE_WIDGET_CLASS :new :managed "disp-slider" calc_keyboard_w
  33.       :XMN_ORIENTATION        :horizontal
  34.       :XMN_PROCESSING_DIRECTION :MAX_ON_RIGHT 
  35.       :XMN_SENSITIVE        nil
  36.       :XMN_MINIMUM        0
  37.       :XMN_MAXIMUM        +100
  38.       :XMN_VALUE        0
  39.       :xmn_width 500
  40.       :xmn_scale_width 500
  41.       :xmn_scale_height 30
  42.       :xmn_height 30
  43.       :xmn_x 0
  44.       :xmn_y 200
  45.       ))
  46.  
  47. (send disp_slider_w :set_values
  48.       :xmn_width 500
  49.       :xmn_scale_width 500
  50.       :xmn_scale_height 30
  51.       :xmn_height 30
  52.       )
  53.  
  54.  
  55.  
  56. ;;
  57. ;; this gets called when a graph node gets clicked, it displays the value
  58. ;; of the clicked graph node and sets that as a possible operand for other
  59. ;; operators
  60. (send *calc_display_class* :answer :set_display_value_from_graphnode '(value-widget)
  61.       '(
  62.     (let ((value
  63.            (truncate (send value-widget :get_value)))
  64.           min_val
  65.           max_val)
  66.       (setq display-value-widget value-widget)
  67.       (setq modify-verify-callback-enabled nil)
  68.       (send-super :set_string (format nil "~A" value))
  69.       (setq modify-verify-callback-enabled t)
  70.       (setq begin-entry-p t)
  71.     
  72.       (send disp_slider_w :get_values 
  73.         :XMN_MINIMUM 'min_val
  74.         :XMN_MAXIMUM 'max_val)
  75.       (format T "value=~A;min=~A; max=~A\n" value min_val max_val)
  76.       (cond
  77.        ((< value min_val)
  78.         (send disp_slider_w :set_value min_val)
  79.         )
  80.        ((> value max_val)
  81.         (send disp_slider_w :set_value max_val)
  82.         )
  83.        (t
  84.         (send disp_slider_w :set_value value)
  85.         )
  86.        )
  87.     )
  88.       )
  89.       )
  90.  
  91.  
  92. (send *calc_display_class* :answer :exec_binary_operator '(operator-symbol)
  93.       '(
  94.     ;; if display-value-widget is non-null, then a result has been set by clicking an operator node in the graph widget;
  95.     ;; on first entering an expression in the display, the :XMN_MODIFY_VERIFY_CALLBACK fires which clears the disp and
  96.     ;; sets display-value-widget to NIL. when display-value-widget is NIL we convert the expression in the display into a sexp and graph it.
  97.     (if (null display-value-widget)
  98.         (setq display-value-widget
  99.           (display-equation (read (make-string-input-stream (strcat "( " (send-super :get_string) " )"))))))
  100.     ;; display-value-widget is now guaranteed to hold widget assoc'd with displayed value
  101.  
  102.     (let (value
  103.           min_val
  104.           max_val)
  105.  
  106.       (cond
  107.        ;; if there is a prev operator, then we want to create a new node corresponding to prev-op-symbol
  108.        ;; whose args are the current value of the accumulator and the current display.
  109.        ;; if the accumilator is NIL, the we don't pass that arg to widget.
  110.        (prev-operator-symbol
  111.         (let ((operator-representor-class (get-operator-class prev-operator-symbol))
  112.           w)
  113.           (cond
  114.            (operator-representor-class ;get-operator-class returns NIL if the operator was not defined with make-operator
  115.         (setq w (send operator-representor-class :new NIL))
  116.         (send w :add_arg display-value-widget)
  117.         (setq display-value-widget w)
  118.         (if accumulator-value-widget
  119.             (send display-value-widget :add_arg accumulator-value-widget))
  120.         (setq modify-verify-callback-enabled nil)
  121.         (send-super :set_string (format nil "~A" (truncate (send display-value-widget :get_value)))) ;display the result
  122.         (setq modify-verify-callback-enabled t)
  123.         (setq accumulator-value-widget display-value-widget)
  124.         )))
  125.         )
  126.        ;; else there was no prev operator, meaning last operation was an ==
  127.        ;; just display the value, and save it in the accumulator for next time
  128.        (t
  129.         (setq modify-verify-callback-enabled nil)
  130.         (send-super :set_string (format nil "~A" (truncate (send display-value-widget :get_value))))
  131.         (setq modify-verify-callback-enabled t)
  132.         (setq accumulator-value-widget display-value-widget)    
  133.         ))
  134.  
  135.       (setq begin-entry-p t)
  136.       (setq prev-operator-symbol operator-symbol)
  137.       (setq value (truncate (send display-value-widget :get_value)))
  138.       (send disp_slider_w :get_values 
  139.         :XMN_MINIMUM 'min_val
  140.         :XMN_MAXIMUM 'max_val)
  141.       (cond
  142.        ((< value min_val)
  143.         (send disp_slider_w :set_value min_val)
  144.         )
  145.        ((> value max_val)
  146.         (send disp_slider_w :set_value max_val)
  147.         )
  148.        (t
  149.         (send disp_slider_w :set_value value)
  150.         )
  151.        )
  152.       )
  153.     ))
  154.